home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / bas_int1.zip / FILEATTR.BAS < prev    next >
BASIC Source File  |  1991-03-23  |  7KB  |  154 lines
  1. '====================================================================
  2. '     From:   Rick Cooper
  3. '     Subj:   File Exist
  4. '
  5. '     Routine For Setting The File's Attribute
  6. '     To Check For A File's Existance You Only Need Use The "Get Attribute"
  7. '     routine. Its Only About 12 or 13 Lines Of Code.
  8.       
  9.      '*********************************************************************
  10.      ' This Code Is QB 4.5
  11.      '
  12.      ' I have Included Functions For Getting And Setting File Attributes
  13.      ' You Should Always Get The Attribute First So That You Only Toggle
  14.      ' The Attribute You Want And Leave Any Other Attributes Alone.
  15.      ' Both Functions Return the Same Error Codes, GetFileAttribute%
  16.      ' Returns The Error In ReturnCode% And The Attribute In It's Name
  17.      ' While Function SetFileAttribute% Returns The Error Code In It's
  18.      ' Name.
  19.      ' Error Codes Are As Follows:
  20.      '       1 = Invalid Function (Networks Only)
  21.      '       2 = File Not Found
  22.      '       3 = Path Not Found
  23.      '       5 = Access Denied (NetWorks Only)
  24.      ' Have You Guessed That GetFileAttribute Would Be Ideal For Checking
  25.      ' For A Path Or File's Existance??? Only 13 Lines Of Code.
  26.      ' Usage:
  27.      '       Attribute% = GetFileAttribute% (FileName$,ReturnCode%)
  28.      '               FileName$ Can Include Full Path Names
  29.      '               ReturnCode% Will Be One Of The Above Or 0
  30.      '               The File Attribute Is Returned In The Function Name
  31.      '
  32.      '      ErrorCode% = SetFileAttribute%(FileName$,FileAttribute%,Attrb$)
  33.      '               FileName$ Can Include Full Path Names
  34.      '               FileAttribute% Is The Attribute You Wish To Change
  35.      '               Attrb$ Is One Or All Of The Following Characters
  36.      '                       A = Archive
  37.      '                       S = System
  38.      '                       H = Hidden
  39.      '                       R = Read Only
  40.      '               Will Accept Characters Of Any Case
  41.      '
  42.      ' I Have Included A SIMPLE Demo With No Error Checking Routine....
  43.      ' And It Will' Continue To Toggle The Attribute As Desired Until You
  44.      ' Press Enter Or Escape.
  45. '==========================================================================
  46.  
  47.      DECLARE FUNCTION GetFileAttribute% (FileName$, ReturnCode%)
  48.      DECLARE FUNCTION SetFileAttribute% (FileName$,FileAttribute%, Attrib$)
  49.      '$INCLUDE: 'qb.bi'
  50.       
  51.      FileName$ = COMMAND$                            'Get The Name Easy
  52.       
  53.      IF FileName$ = "" THEN
  54.              INPUT "Enter file name "; FileName$     'Or get it direct
  55.      END IF
  56.       
  57.      CLS                                             'Clear the screen
  58.       
  59.      start:                                          'OH GOD A LABEL!!!!
  60.       
  61.      Attrb$ = STRING$(4, 95)                         'Set up the blanks
  62.      FAttrb% = GetFileAttribute%(FileName$, RC%)     'Get the attribute
  63.                                                    'And set string properly
  64.       
  65.      IF (FAttrb% AND 1) = 1 THEN MID$(Attrb$, 1, 1) = "R"
  66.      IF (FAttrb% AND 2) = 2 THEN MID$(Attrb$, 2, 1) = "H"
  67.      IF (FAttrb% AND 4) = 4 THEN MID$(Attrb$, 3, 1) = "S"
  68.      IF (FAttrb% AND &H20) = &H20 THEN MID$(Attrb$, 4, 1) = "A"
  69.       
  70.      mess$ = FileName$ + "  " + Attrb$          ' Show the name and current
  71.                                                      ' file attribute
  72.      LOCATE 1, 1
  73.      PRINT mess$                                     'And print it
  74.       
  75.      IF RC% = 0 THEN                                'Check for error and if
  76.                                                      'none go on and toggle
  77.       
  78.      Ans$ = INPUT$(1)                              'Get attribute to toggle
  79.                                                      'or request to exit
  80.       
  81.      IF Ans$ = CHR$(27) OR Ans$ = CHR$(13) THEN SYSTEM
  82.              RC% = SetFileAttribute%(FileName$, FAttrb%, Ans$)     'TOGGLE
  83.              Ans$ = ""                                             'Clear
  84.              GOTO start                              'OH GOD A GOTO!!!!!
  85.      ELSE
  86.              PRINT "Error #" + LTRIM$(STR$(RC%))   'Yep, and error so print
  87.                                                      'code and exit
  88.              SYSTEM
  89.      END IF
  90.       
  91.      FUNCTION GetFileAttribute% (FileName$, ReturnCode%)
  92.      '*********************************************************************
  93.      'Now To The Meat Of Things... This Will Quickly Tell If A File Exists
  94.      'Or Not.
  95.      '*********************************************************************
  96.       
  97.      DIM InRegs AS RegTypeX, OutRegs AS RegTypeX     'Dimension Register
  98.                                                      'Types
  99.      FileToSet$ = FileName$ + CHR$(0)                'Make ASCIIZ String
  100.                                                      'From File Name
  101.      ReturnCode% = 0                                 'Zero Return Code
  102.       
  103.      InRegs.ax = (256 * &H43) + &H0                  'Set Function Number
  104.      InRegs.ds = VARSEG(FileToSet$)                  'Pass Segment Of Name
  105.      InRegs.dx = SADD(FileToSet$)                    'Pass Offset Of Name
  106.      CALL INTERRUPTX(&H21, InRegs, OutRegs)          'Call Interrupt 21
  107.       
  108.      IF (OutRegs.flags AND 1) = 0 THEN               'Is There Any Errors?
  109.       
  110.              GetFileAttribute% = OutRegs.cx         'Nope..Return Attribute
  111.      ELSE
  112.              ReturnCode% = OutRegs.ax                'Yep! Pass Error Code
  113.      END IF
  114.      END FUNCTION
  115.       
  116.       
  117.      FUNCTION SetFileAttribute% (FileName$, FileAttribute%, Attrib$)
  118.       
  119.      DIM InRegs AS RegTypeX, OutRegs AS RegTypeX    'Dimension Register
  120.                                                     'Types
  121.      Attrib$ = UCASE$(Attrib$)                      'Make Sure It's
  122.                                                     'Upper Case
  123.      FileToSet$ = FileName$ + CHR$(&H0)             'Convert Name to
  124.                                                     'ASCIIZ
  125.      FOR i = 1 TO LEN(Attrib$)                      'Toggle All The
  126.                                                     'Any Selected
  127.      SELECT CASE MID$(Attrib$, i, 1)                'Attributes
  128.       
  129.      CASE IS = "R"
  130.              FileAttribute% = FileAttribute% XOR &H1 'Toggle Read Only
  131.      CASE IS = "H"
  132.              FileAttribute% = FileAttribute% XOR &H2 'Toggle Hidden
  133.      CASE IS = "S"
  134.              FileAttribute% = FileAttribute% XOR &H4 'Toggle System
  135.      CASE IS = "A"
  136.              FileAttribute% = FileAttribute% XOR &H20'Toggle Archive
  137.      END SELECT
  138.      NEXT i
  139.      
  140.      InRegs.ax = (256 * &H43) + &H1                  'Load Set Function
  141.      InRegs.cx = FileAttribute%                      'Attribute To Set
  142.      InRegs.ds = VARSEG(FileToSet$)                  'Pass Segment
  143.      InRegs.dx = SADD(FileToSet$)                    'Pass Offset
  144.      CALL INTERRUPTX(&H21, InRegs, OutRegs)          'Call Interrupt 21
  145.      
  146.      IF (OutRegs.flags AND 1) <> 0 THEN              'Is There An Error?
  147.              SetFileAttribute% = OutRegs.ax          'Yep! Pass Error
  148.      ELSE                                            'Nope..Pass Zero
  149.              SetFileAttribute% = 0
  150.      END IF
  151.      
  152.      END FUNCTION
  153.  
  154.